perm filename ITMX.F4[XX,LCS] blob
sn#195565 filedate 1976-01-08 generic text, type T, neo UTF8
00100 C**** ITMSUB, BMS, METER, RNOTE, MAKNUM, IABS, DRWNT, RHORZ, RDRAW
00200 C ********** WHOLE & HALF RESTS, BEAMS ******
00300 SUBROUTINE ITMSUB
00400 IMPLICIT INTEGER(A-Q,S-Z)
00500 REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
00600 COMMON/STF/RSTFAC(-3/4),RSTJ2/MIN/MINI,RMINI
00700 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY
00800 COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
00900 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
01000 1 RJA,YY,DISX,HGT,RZ,INP(53)
01100 COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
01200 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01300 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01400 1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
01500 1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
01600 DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
01700 1,RDBR/ 3.5/,RBR/.33/,RBX/ 7.0/
01800 C RDBR IS SPACER FOR DBL BAR.
01900 C RTF COMPENSATES FOR BAD PLANNING.
01950 IF(JA.EQ.4)GO TO 90
01960 CALL BMSTF
01970 RETURN
02000 90 RST7=RSTJ2*7.
02100 RST18=RSTJ2*18.
02200 C TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02300
02400 R3Q=R3
02500 CC??? JY=0
02600 CC IF(JA.EQ.6)GO TO 90
02700 CC IF(JA.EQ.8)GO TO 100
02800 C GO TO LINES, BEAMS, STAVES.
02900 C NEXT DRAWS STRAIGHT LINES
03000
03100 RD=R4*RST7
03200 RA=0
03300 RX=RTF*RSTJ2+POS
03400 C SOMEDAY ADD < RDIS=1./DIS > TO REPLACE ALL 1./DIS'S
03500 IF(J5.EQ.50)GO TO 300
03600 C 50 IS FOR CRESC., DECRESC. AND BOXES
03700 IF(R6.NE.0)GO TO 401
03800 IF(J7.NE.0)GO TO 401
03900 C FOR BAR LINES
04000 4000 JA=44
04100 C CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
04200 C ↑↑↑↑↑↑↑↑↑ FOR VERTICAL WIGGLE (P6=0, P7=-1)
04300 DBR=0
04400 IF(J4.LT.1000)GO TO 400
04500 C J4=1001 = DBL BAR, =1401 = DBL BAR WITH RT. ONE HEAVY: J5=1=DOTS ADDED
04600 CK J4=J4-1000
04700 CK DBR=-1
04800 CK400 J7=(J4/100)*DIS
04900 DBR=J4/1000
05000 J4=J4-DBR*1000
05100 C DBR=1 HEAVY BAR IS ON RT. =2 ON LEFT. =3 IN MIDDLE.
05200 9400 RD=RDBR+RDBR*RSTJ2
05300 C TO SPACE THIN BAR FROM HEAVY
05400 IF(J5.EQ.0)GO TO 400
05500 C NEXT ADDS REPEAT DOTS TO DBL BAR.
05600 L=J4
05700 RJ=L/100
05800 IF(RJ.EQ.0)RJ=6.*RSTJ2
05900 C HEAVY BAR WILL BE 5 LINES WIDE.
05910 RZ=R3
06000 J4=0
06100 C MUST BE 0 FOR DOTS IN 'NOTWRT'
06200 IF(DBR.EQ.0)DBR=J5
06300 J5=0
06400 C J5=1 RPT ←, =2 RPT →, =3 RPT ↔
06500 RJA=RD*2.
06600 C TO SPACE DOTS, NOT ACCURATE FOR VERY SMALL OR VERY LARGE SIZE FACTORS
06700 JY=DBR
06800 IF(DBR.LT.2)GO TO 8400
06900 R3=RJA+RJ+RZ
07000 7400 DO 3400 K=J2,MOD(L,100)+J2-1
07100 RSTJ2=RSTFAC(K)
07200 POS=STFF(K)
07300 R4=6
07400 CALL CENTX
07500 C SPACES DOTS OUT FROM BAR
07600 CALL RDRAW(1,17.0,RDOT,RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
07700 C GO GET THE DOT
07800 R4=8
07900 CALL CENTX
08000 3400 CALL RDRAW(1,17.0,RDOT,RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
08100 JY=JY-1
08200 IF(JY.LT.2)GO TO 4400
08300 8400 R3=RZ-RJA-4.*RSTJ2
08400 GO TO 7400
08500 C DO I NEED ANY MORE RESETS????
08600 4400 J4=L
08610 J7=RJ*DIS
08620 GO TO 5400
08700 400 IF(J5.NE.0)GO TO 9400
08800 K=J4/100
08900 C K IS FOR SPACING OF THIN BAR IN HEAVY-THIN ORDER
09000 J7=K*DIS
09100 C J7=NUM OF STROKES -- BASED ON FINAL SIZE FACTOR (DIS)
09200 5400 L=MOD(J4,100)
09300 IF(L.EQ.0)L=1
09400 L=L+J2-1
09500 C J4=401 MAKES 4X THICK BARLINE - ONE STAFF
09600 RA=RTF
09700 IF(L.LE.4)GO TO 2400
09800 L=4
09900 RA=300.
10000 C FOR EXTENDING BARS ABOVE STAFF 4
10100 2400 RY=RSTFAC(L)
10110 RZ=R3Q
10155 C SAVE IT FOR DBL RPT BAR.
10200 RY=STFF(L)+(RA+56.)*RY
10300 1400 RA=1
10400 IF(PLT.GE.0)GO TO 140
10500 J7=J7+1
10600 RA=1./DIS
10700 C BAR LINES PLOT AS DOUBLE THICKNESS
10800 140 RJX=R3Q
10900 42 CALL LINES(R3Q,RX,3)
11000 RJ=-1.
11100 RW=RY
11200 406 CALL LINES(RJX,RY,2)
11300 IF(J10.EQ.0)GO TO 411
11400 C P10 WILL THICKEN VERTICAL (OR MOSTLY VERTICAL) LINES.
11500 J7=J10*DIS
11600 J10=0
11700 RA=1./DIS
11800 411 IF(J7.GT.0)GO TO 409
11900 IF(DBR.LE.0)RETURN
12000 RY=RW
12100 CK R3Q=R3Q-RDBR
12200 RA=RJX+RD
12300 IF(DBR.EQ.1)RA=RZ-RD
12400 DBR=DBR-2
12500 R3Q=RA
12600 GO TO 1400
12700 CC411 IF(J7.LE.0)RETURN
12800 C FOR 'HEAVY' LINE.
12900 409 RJX=RJX+RA
13000 CALL LINES(RJX,RY,2)
13100 J7=J7-1
13200 RY=RW
13300 IF(RJ)RY=RX
13400 RJ=-RJ
13500 GO TO 406
13600 CC43 IF(RA.LE.0)RETURN
13700 C HOW IS RA.NE.0?
13800 C DRAWS BAR LINES. J4>0 CAUSES FULL LINE.
13900 CC403 RA=RA-3.72
14000 CC R3Q=R3Q+22
14100 CC RJX=RJX+22
14200 C DO ABOVE NEED *RSTJ2? ************
14300 C **** BASED ON '596' ****
14400 CC GO TO 42
14500
14600 C FOR CRESC., DECRESC.
14700 300 IF(R7.EQ.0)R7=2.3
14800 IF(R7.EQ.-1.)R7=-2.3
14900 RA=ABS(R7/2.0)*RST7
15000 C AMOUNT OF SPREAD
15100 RJ=R3Q
15200 RX=RX-RST18+RD
15300 IF(R8.NE.0)GO TO 302
15400 C JUMP TO MAKE BOX
15500 R6=RHORZ(R6)
15600 IF(R7)GO TO 301
15700 RJ=R6
15800 R6=R3Q
15900 301 CALL LINX(RJ,RX+RA,R6,RX)
16000 CALL LINES(RJ,RX-RA,2)
16100 C FOR CRESC, DECRESC:4 POS1, STF, HGT, 50, POS1, +OR-N(0=2.3,-1=-2.3)
16200 CC IF(PLT.NE.-2)RETURN
16300 IF(PLT.GE.0)RETURN
16400 C THIS MAKES ALL CRESC. DBL THICKNESS AT PRINT TIME.
16500 IF(J8)RETURN
16600 RX=RX+1./DIS
16700 J8=-1
16800 C FOR DOUBLE THICKNESS
16900 GO TO 301
17000
17100 302 R8=R8*RST7
17200 R9=R9*RST7
17300 IF(R9.EQ.0)R9=R8
17400 C R9=0 MAKES SQUARE
17500 R3=R3Q-R8/2.
17600 RX=RX-R9/2.
17700 J10=J10*DIS
17800 C DRAWS BOX, CENTER IS IN MIDDLE
17900 C 4,POS,STF,NT#,50,0,0,,SIZ1[BY NT#S],SIZ2
18000 1302 CALL LINX(R3,RX,R3+R8,RX)
18100 CALL LINES(R3+R8,RX+R9,2)
18200 CALL LINES(R3,RX+R9,2)
18300 CALL LINES(R3,RX,2)
18400 IF(J10.EQ.0)RETURN
18500 J10=J10-1
18600 RJ=1./DIS
18700 R3=R3-RJ
18800 R8=R8+RJ+RJ
18900 RX=RX-RJ
19000 R9=R9+RJ+RJ
19100 GO TO 1302
19200 C TO THICKEN BOXES.
19300
19400 1401 R4=2.0
19500 C FOR HEAVY BRACK.
19600 RA=RSTJ2*RBX
19700 RX=RX-RA
19800 C THE BOTTOM
19900 L=J4+J2-1
20000 R6=RTF
20100 IF(L.LE.4)GO TO 4401
20200 L=4
20300 R6=300.
20400 4401 RA=STFF(L)
20500 C SAVE FOR POS. OF BRACK. END ON UPPER STAFF.
20600 RJY=RSTFAC(L)
20700 RY=RA+R6*RJY+RJY*56.+RJY*RBX
20800 C THE TOP
20900 R5=9.5
21000 GO TO 2401
21100
21200 C DASHES
21300 401 POS=POS-RST18
21400 C********* 27/9/72 ******
21500 IF(J7.LE.0)GO TO 407
21600 IF(J7.EQ.4)GO TO 1401
21700 IF(J7.NE.3)GO TO 4001
21800 C NEXT IS FOR VARIABLE LARGE BRACKET. P7=3 P10=THICK. P5=HGT P6=P3
21900 2401 JA=3
22000 IF(J10.EQ.0)J10=5
22100 C DEFAULT VALUE FOR THICKNESS =5
22200 R4=R4-RBR
22300 J9=0
22400 J5=35
22500 C THE NUM FOR THE LITTLE END ITEMS
22600 CC RY=R6-2.1*RSTJ2
22700 R6=3
22800 R7=0
22900 C DOES LOWER ONE FIRST. ITEM IS IN 'CLEF3.DMD' ON DAT.LCS
23000 IF(J8.NE.2)CALL CLEFS
23100 C P8=1=BOTTOM 1/2 BRACK. ONLY: =2=TOP 1/2 ONLY: 0=COMPLETE
23200 R4=R5-RBR
23300 R6=3
23400 R7=-3
23500 C TURNS IT UPSIDE DOWN.
23600 CC JA=3
23700 IF(J7.NE.4)GO TO 3401
23800 POS=RA
23900 R4=R4*RJY/RSTJ2
24000 C TO ADJUST HEIGHT OF BRACK END WHEN STAVES ARE DIFF. SIZES.
24100 3401 IF(J8.NE.1)CALL CLEFS
24200 R3Q=R3Q-12.0*RSTJ2
24300 IF(J7.NE.4)GO TO 407
24400 J7=0
24500 GO TO 140
24600
24700 4002 J5=4
24800 C FOR CURVY BRACKET. P6 CAN CHANGE WIDTH.
24900 R8=0
25000 J4=J4+J2-1
25100 R7=(.3136*RSTFAC(J4)+.0056*(STFF(J4)-STFF(J2)))/RSTJ2
25200 C .0056=.0392/7.(THE MAGIC NUM FOR VERT SIZE OF BRACK.) .3136=8*.0392
25300 C ADD DIST BETWEEN BOTTOM OF STAVES TO HEIGHT OF TOP STAFF
25400 IF(R6.EQ.0)R6=1.+R7/20.
25500 JA=3
25600 R4=2.3
25700 C C BECAUSE BRACK DOESN'T REALLY GO UP FROM 0 ?!?X*⊗
25800 CALL CLEFS
25900 RETURN
26000
26100 4001 IF(J7.EQ.5)GO TO 4002
26200 IF(R8.EQ.0)R8=.8
26300 C P8 CAN SET SIZE OF DASH
26400 RD=RD+POS
26500 IF(J7.EQ.1)GO TO 402
26600 C =1 =VERTICAL DASHES
26700 RA=RHORZ(R6)
26800 RST7=5.96*RSTJ2
26900 RJX=R3Q
27000 GO TO 420
27100 402 RA=POS+R5*RST7
27200 RJY=RD
27300 C SAVE FOR THICK LINES
27400 420 RJ=R8*RST7
27500 41 L=3
27600 K=2
27700 416 CALL LINES(R3Q,RD,L)
27800 IF(J7.EQ.1)GO TO 412
27900 C JUMP FOR VERTICAL DASH
28000 IF(R3Q.GE.RA)GO TO 413
28100 C JUMP IF ALL DONE
28200 R3Q=R3Q+RJ
28300 414 CALL EXCH(L,K)
28400 GO TO 416
28500 412 IF(RD.GE.RA)GO TO 413
28600 C JUMP IF DONE
28700 RD=RD+RJ
28800 GO TO 414
28900 413 IF(J10.LE.0)RETURN
29000 C NEXT FOR THICK DASHES
29100 J10=J10-1
29200 IF(J7.EQ.1)GO TO 415
29300 R3Q=RJX
29400 RD=RD+1./DIS
29500 GO TO 41
29600 415 R3Q=R3Q+1./DIS
29700 RD=RJY
29800 GO TO 41
29900
30000
30100 407 RX=RD+POS
30200 RY=R5*RST7+POS
30300 IF(J7.EQ.3)GO TO 140
30400 CALL NOZERO(R9)
30500 IF(J7.EQ.-1)GO TO 408
30600 C FOR 'TR' J7=-2, 'ARPEGG' J7=-1, STRAIGHT LINES J7=0
30700 CC WHY THE IFIX???? RJX=IFIX(RHORZ(R6))
30800 RJX=IFIX(ROFF(RHORZ(R6)))
30900 C ALL THIS CRAP SO IT WILL MATCH UP WITH P3 WHEN NECESSARY.
31000 IF(J7.EQ.0)GO TO 42
31100 RY=R9*RST7+RX
31200 CALL NOZERO(R8)
31300 4041 RZ=RX
31400 RH=RY
31500 C SAVE FOR THICK WIGGLES
31600 CALL LINES(R3Q,RX,3)
31700 C DRAWS STRAIGHT LINES. ETC.
31800 R9=R3Q
31900 RJ=RY
32000 RW=3.*RSTJ2*R8
32100 RA=RW*2.5
32200 C P8=HORZ. WIGGLE SIZE; P9=VERT. SIZE
32300 404 R9=R9+RA
32400 CALL LINES(R9,RJ,2)
32500 R9=R9+RW
32600 CALL LINES(R9,RJ,2)
32700 405 CALL EXCH(RX,RJ)
32800 IF(R9.LT.RJX)GO TO 404
32900 IF(J10.LE.0)RETURN
33000 RX=RZ+1./DIS
33100 RY=RH+1./DIS
33200 J10=J10-1
33300 GO TO 4041
33400 C P10= + NUM OF THICKNESSES TO WIGGLE
33500
33600 408 IF(RX.GT.RY)CALL EXCH(RX,RY)
33700 RZ=R9*RSTJ2*5.96
33800 C USE P9 TO SET WIGGLE WIDTH. P8 TO SET HGT.
33900 CALL NOZERO(R8)
34000 RD=R8*RST7*.5
34100 RJ=RD
34200 IF(RD.LT.1.)RD=1.
34300 421 R9=RX
34400 RW=R3Q
34500 RA=RZ+R3Q
34600 CALL LINES(RW,R9,3)
34700 410 R9=R9+RJ
34800 CALL LINES(RA,R9,2)
34900 R9=R9+RD
35000 CALL LINES(RA,R9,2)
35100 CALL EXCH(RA,RW)
35200 IF(R9.LT.RY)GO TO 410
35300 IF(J10.LE.0)RETURN
35400 R3Q=R3Q+1./DIS
35500 J10=J10-1
35600 GO TO 421
35700 C VERTICAL WIGGLE P10=+ NUM OF THICKNESSES.
35800
35900 END